home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / improv1a / progress.ctl < prev    next >
Text File  |  1999-08-27  |  9KB  |  298 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Progress 
  3.    Alignable       =   -1  'True
  4.    BackStyle       =   0  'Transparent
  5.    ClientHeight    =   525
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   4905
  9.    EditAtDesignTime=   -1  'True
  10.    ForeColor       =   &H8000000F&
  11.    ForwardFocus    =   -1  'True
  12.    PropertyPages   =   "Progress.ctx":0000
  13.    ScaleHeight     =   525
  14.    ScaleWidth      =   4905
  15.    ToolboxBitmap   =   "Progress.ctx":0023
  16.    Begin VB.PictureBox Pic1 
  17.       AutoRedraw      =   -1  'True
  18.       FillStyle       =   0  'Solid
  19.       FontTransparent =   0   'False
  20.       Height          =   375
  21.       Left            =   60
  22.       ScaleHeight     =   315
  23.       ScaleWidth      =   4695
  24.       TabIndex        =   0
  25.       Top             =   60
  26.       Width           =   4755
  27.    End
  28. End
  29. Attribute VB_Name = "Progress"
  30. Attribute VB_GlobalNameSpace = False
  31. Attribute VB_Creatable = True
  32. Attribute VB_PredeclaredId = False
  33. Attribute VB_Exposed = True
  34. '
  35. '  Progress Bar Control - By Jack Rizzo, SBN Software
  36. '
  37. '  Based on a routine developed by Aldo Peirano and submitted
  38. '  to "Visual Basic Source Code" on 15 August, 1999.
  39. '
  40. Option Explicit
  41. Enum StyleA
  42.    [PercentHorz]
  43.    [LabelPercentHorz]
  44.    [BareLabelHorz]
  45.    [BareLabelVert]
  46.    [PercentVert]
  47. End Enum
  48. Enum BsytleA
  49.    [Flat]
  50.    [3D]
  51. End Enum
  52. Private m_Caption As String
  53. Private m_Visible As Boolean
  54. Private m_Enabled As Boolean
  55. Private m_ForeColor As Long
  56. Private m_Max As Long
  57. Private m_Min As Long
  58. Private m_Style As StyleA
  59. Private m_Border As BsytleA
  60.  
  61. 'MappingInfo=UserControl,UserControl,-1,ForeColor
  62. Public Property Get ForeColor() As OLE_COLOR
  63. Attribute ForeColor.VB_Description = "Sets Color of the Progess Bar and Associated text"
  64. Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
  65.    ForeColor = UserControl.ForeColor
  66. End Property
  67. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  68. UserControl.ForeColor() = New_ForeColor
  69. Pic1.ForeColor = New_ForeColor
  70. PropertyChanged "ForeColor"
  71. End Property
  72. 'MappingInfo=UserControl,UserControl,-1,Font
  73. Public Property Get Font() As Font
  74. Attribute Font.VB_Description = "Sets the font for the progress bar text"
  75. Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
  76.    Set Font = UserControl.Font
  77. End Property
  78.  
  79.  
  80. Public Property Set Font(ByVal New_Font As Font)
  81.    Set UserControl.Font = New_Font
  82.    PropertyChanged "Font"
  83. End Property
  84. 'MappingInfo=UserControl,UserControl,-1,Visible
  85. Public Property Get Visible() As Boolean
  86. Attribute Visible.VB_Description = "Boolean value making progress bar visible or not."
  87. Attribute Visible.VB_ProcData.VB_Invoke_Property = ";Behavior"
  88.    Visible = m_Visible
  89. End Property
  90.  
  91. Public Property Let Visible(ByVal New_Visible As Boolean)
  92.    m_Visible = New_Visible
  93.    Pic1.Visible = m_Visible
  94.    PropertyChanged "Visible"
  95. End Property
  96. 'mappingInfo=UserControl,UserControl,-1,Caption
  97. Public Property Get Caption() As String
  98. Attribute Caption.VB_Description = "Defines the Lable to be used in the bar for styles that use lables."
  99.    Caption = m_Caption
  100. End Property
  101.  
  102. Public Property Let Caption(ByVal New_Caption As String)
  103.   m_Caption = New_Caption
  104.   PropertyChanged "Caption"
  105. End Property
  106.  
  107.  
  108. Public Function Change(Value As Long)
  109. Attribute Change.VB_Description = "Method used to change the progress bar value."
  110. Dim myval As Long
  111. If m_Enabled = False Then
  112.    Exit Function
  113. End If
  114. myval = Value
  115. If myval < Min Or myval > Max Then
  116.    Err.Raise vbObjectError + 1, "Progress", "Progress Bar Value for Min or Max out of bounds"
  117. End If
  118. If Min = Max Then
  119.    Err.Raise vbObjectError + 2, "Progress", "Progress Bar Min and Max are Equal"
  120. End If
  121. If Max < Min Then
  122.    Err.Raise vbObjectError + 3, "Progress", "Progress Bar Max value is less than Min"
  123. End If
  124. Select Case Style
  125.    Case PercentHorz
  126.       Call Prog(Pic1, myval, Max)
  127.     Case LabelPercentHorz
  128.       If Left(Caption, 1) <> "%" Then
  129.          Caption = "%" & Caption
  130.       End If
  131.       Call Prog(Pic1, myval, Max, Caption)
  132.    Case BareLabelHorz
  133.       Call Prog(Pic1, myval, Max)
  134.    Case BareLabelVert
  135.       Call Prog(Pic1, myval, Max)
  136.    Case PercentVert
  137.       Call Prog(Pic1, myval, Max)
  138. End Select
  139. Pic1.Refresh
  140. DoEvents
  141. End Function
  142.  
  143. Public Function Clear()
  144. Attribute Clear.VB_Description = "Clears the progress bar."
  145. If m_Enabled = False Then
  146.    Exit Function
  147. End If
  148. Pic1.Cls
  149. End Function
  150.  
  151.  
  152. Private Sub Prog(OBJ As PictureBox, ByVal Current As Long, _
  153.     Max As Long, Optional Caption As String)
  154. Dim myscale As Long
  155. Dim Percent As String
  156. Dim Tmp As Long
  157. Dim xcount As Single
  158. Dim base As Single
  159. Dim xxy As Single
  160. If Current < Min Or Current > Max Then
  161.    Exit Sub
  162. End If
  163. If Not OBJ.AutoRedraw Then
  164.     OBJ.AutoRedraw = -1
  165. End If
  166. OBJ.Cls
  167. If Caption = "" Then
  168.     Percent = Format(Str((Current - Min) / (Max - Min + 1)) * 100, "###0") + "%"
  169.   ElseIf Left(Caption, 1) = "%" Then
  170.     Percent = Mid(Caption, 2, Len(Caption) - 1) + " " + Format(Str((Current - Min) / (Max - Min + 1)) * 100, "###0") + "%"
  171.   Else
  172.     Percent = Caption
  173. End If
  174. OBJ.ScaleWidth = Max - Min
  175. OBJ.DrawMode = 10
  176. OBJ.Font = UserControl.Font
  177. OBJ.Font.Size = UserControl.Font.Size
  178. OBJ.ForeColor = UserControl.ForeColor
  179. OBJ.Font.Bold = UserControl.Font.Bold
  180. OBJ.Font.Italic = UserControl.Font.Italic
  181. OBJ.Font.Underline = UserControl.Font.Underline
  182. If Style <> BareLabelHorz And Style <> BareLabelVert Then
  183.    OBJ.CurrentX = (OBJ.ScaleWidth / 2 - OBJ.TextWidth(Percent) / 2)
  184.    OBJ.CurrentY = (OBJ.ScaleHeight - OBJ.TextHeight(Current)) / 2
  185.    OBJ.Print Percent
  186. End If
  187. If Style > 2 Then
  188.        OBJ.ScaleHeight = Max - Min
  189.        myscale = OBJ.ScaleHeight - (Current - Min)
  190.        OBJ.Line (0, OBJ.ScaleHeight)-(OBJ.ScaleWidth, myscale), , BF
  191. Else
  192.     OBJ.Line (0, 0)-((Current - Min), OBJ.Width), , BF
  193. End If
  194. OBJ.Refresh
  195. DoEvents
  196. End Sub
  197.  
  198.  
  199. Private Sub UserControl_Initialize()
  200. m_Enabled = True
  201. m_Visible = True
  202. m_ForeColor = ForeColor
  203. m_Border = [3D]
  204. End Sub
  205.  
  206.  
  207. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  208. UserControl.ForeColor = PropBag.ReadProperty("ForeColor", m_ForeColor)
  209. Set Font = PropBag.ReadProperty("Font", Ambient.Font)
  210. m_Visible = PropBag.ReadProperty("Visible", True)
  211. m_Style = PropBag.ReadProperty("Style", m_Style)
  212. m_Border = PropBag.ReadProperty("Border", m_Border)
  213. m_Enabled = PropBag.ReadProperty("Enabled", m_Enabled)
  214. m_Caption = PropBag.ReadProperty("Caption", m_Caption)
  215. m_Max = PropBag.ReadProperty("Max", m_Max)
  216. m_Min = PropBag.ReadProperty("Min", m_Min)
  217. End Sub
  218.  
  219. Private Sub UserControl_Resize()
  220. Pic1.Width = UserControl.Width - 165
  221. Pic1.Height = UserControl.Height - 100
  222. Pic1.BorderStyle = m_Border
  223. End Sub
  224.  
  225. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  226. Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, m_ForeColor)
  227. Call PropBag.WriteProperty("Font", Font, Ambient.Font)
  228. Call PropBag.WriteProperty("Visible", m_Visible, True)
  229. Call PropBag.WriteProperty("Style", m_Style, 0)
  230. Call PropBag.WriteProperty("Border", m_Border, 1)
  231. Call PropBag.WriteProperty("Enabled", m_Enabled, True)
  232. Call PropBag.WriteProperty("Caption", m_Caption, "")
  233. Call PropBag.WriteProperty("Min", m_Min, 0)
  234. Call PropBag.WriteProperty("Max", m_Max, 100)
  235. End Sub
  236. 'MappingInfo,UserControl,UserControl,-1,Style
  237. Public Property Get Style() As StyleA
  238. Attribute Style.VB_Description = "One of five styles for displaying the Progress bar."
  239. Attribute Style.VB_ProcData.VB_Invoke_Property = ";Appearance"
  240. Style = m_Style
  241. End Property
  242.  
  243. Public Property Let Style(ByVal vNewValue As StyleA)
  244. m_Style = vNewValue
  245. PropertyChanged "Style"
  246. End Property
  247.  
  248. Public Property Get border() As BsytleA
  249. Attribute border.VB_Description = "Defines one of two types of borders for display. Either Flat or 3D."
  250. border = m_Border
  251. End Property
  252. Public Property Let border(ByVal NewValue As BsytleA)
  253. m_Border = NewValue
  254. If m_Border = [3D] Then
  255.    Pic1.BorderStyle = 1
  256. Else
  257.    Pic1.BorderStyle = 0
  258. End If
  259. PropertyChanged "Border"
  260.  
  261. End Property
  262. 'MappingInfo,UserControl,UserControl,-1,Enable
  263. Public Property Get Enabl